Dr. Windows 3/dr win3.zip/dr win3/WINPROGS/SPMATE13.ZIP/SAVEFILE.FR$/savefile.frm

Text File | 1993-07-09 | 5KB | 190 lines

VERSION 2.00
Begin Form SaveFile
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Enter File Name for Save"
   Height          =   3480
   Icon            =   0
   Left            =   960
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   ScaleHeight     =   3105
   ScaleWidth      =   4830
   Top             =   1200
   Width           =   4920
   Begin CommandButton Command2
      Caption         =   "Cancel"
      Height          =   375
      Left            =   3480
      TabIndex        =   7
      Top             =   1800
      Width           =   1095
   End
   Begin DriveListBox Drive1
      Height          =   315
      Left            =   2025
      TabIndex        =   0
      Top             =   1560
      Width           =   1215
   End
   Begin CommandButton Command1
      Caption         =   "OK"
      Default         =   -1  'True
      Height          =   375
      Left            =   3465
      TabIndex        =   6
      Top             =   1305
      Width           =   1095
   End
   Begin DirListBox Dir1
      Height          =   1815
      Left            =   240
      TabIndex        =   1
      Top             =   1080
      Width           =   1575
   End
   Begin TextBox Text1
      Height          =   315
      Left            =   1200
      TabIndex        =   2
      Text            =   " "
      Top             =   240
      Width           =   3015
   End
   Begin Label Label5
      AutoSize        =   -1  'True
      Caption         =   "Drives:"
      Height          =   195
      Left            =   2025
      TabIndex        =   5
      Top             =   1335
      Width           =   615
   End
   Begin Label Label1
      AutoSize        =   -1  'True
      Height          =   195
      Left            =   2160
      TabIndex        =   3
      Top             =   855
      Width           =   2055
   End
   Begin Label Label4
      AutoSize        =   -1  'True
      Caption         =   "Directories:"
      Height          =   195
      Left            =   240
      TabIndex        =   4
      Top             =   825
      Width           =   990
   End
   Begin Label Label2
      AutoSize        =   -1  'True
      Caption         =   "File Name:"
      Height          =   195
      Left            =   240
      TabIndex        =   8
      Top             =   240
      Width           =   915
   End
End
Const TEXTFLAG = 0
Const DIRFLAG = 1

Dim SelectFlag As Integer

Sub Command1_Click ()
   On Error GoTo ErrorTrap

   If SelectFlag = DIRFLAG Then
      Dir1.Path = Dir1.List(Dir1.ListIndex)
      Dir1_Change
      SelectFlag = TEXTFLAG
   ElseIf InStr(Text1.Text, "\") Then
      Tmp$ = Text1.Text
      Do Until Right$(Tmp$, 1) = "\"
         Tmp$ = Left$(Tmp$, Len(Tmp$) - 1)
      Loop
      If Len(Tmp$) > 3 Then
         Tmp$ = Left$(Tmp$, Len(Tmp$) - 1)
      End If
      Dir1.Path = Tmp$
      Do
         Text1.Text = Mid$(Text1.Text, InStr(Text1.Text, "\") + 1)
      Loop While InStr(Text1.Text, "\")
   Else
      Tmp$ = LTrim$(RTrim$(Text1.Text))
      If Tmp$ <> "" Then
         If Right$(Dir1.Path, 1) = "\" Then
            FullFilePath = Dir1.Path + Tmp$
         Else
            FullFilePath = Dir1.Path + "\" + Tmp$
         End If
         Unload SaveFile
      Else
         Beep
         Text1.SetFocus
      End If
   End If

   Exit Sub

ErrorTrap:
   Beep
   Resume Next
End Sub

Sub Command2_Click ()
   Unload SaveFile
End Sub

Sub Dir1_Change ()
   FillLabel1
   Drive1.Drive = Dir1.Path
   SelectFlag = DIRFLAG
End Sub

Sub Dir1_Click ()
   SelectFlag = DIRFLAG
End Sub

Sub Drive1_Change ()
   Dir1.Path = Drive1.Drive
   SelectFlag = DIRFLAG
End Sub

Sub FillLabel1 ()
   Label1.Caption = Dir1.Path
   If Label1.Width > 2055 Then
      a$ = Left$(Dir1.Path, 3)
      b$ = Mid$(Dir1.Path, 4)
      Do While InStr(b$, "\")
         b$ = Mid$(b$, InStr(b$, "\") + 1)
      Loop
      Label1.Caption = a$ + "...\" + b$
   End If
End Sub

Sub Form_Load ()
   SaveFile.Left = (Screen.Width - SaveFile.Width) / 2
   SaveFile.Top = (Screen.Height - SaveFile.Height) / 2

   If FullFilePath <> "" Then
      Tmp$ = FullFilePath
      Do Until Right$(Tmp$, 1) = "\"
         Tmp$ = Left$(Tmp$, Len(Tmp$) - 1)
      Loop
      Tmp$ = Tmp$ + WILDCARD$
   End If

   FillLabel1
   SelectFlag = TEXTFLAG
End Sub

Sub Form_Resize ()
   Text1.SetFocus
End Sub

Sub Text1_Change ()
   SelectFlag = TEXTFLAG
End Sub